home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / DELPHI32 / BUTTONS / XTOOLBTN / XPROCS.INT < prev    next >
Text File  |  1996-05-26  |  14KB  |  353 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {       xTool - Component Collection                    }
  4. {                                                       }
  5. {       Copyright (c) 1995 Stefan B÷ther                }
  6. {                                                       }
  7. {*******************************************************}
  8. {
  9.    03.12.95  Added new RectXXXX functions from Golden Software     Stefc
  10.    03.12.95  remove confict Int with Int_                          Stefc
  11.    06.01.96  added sysTempPath and sysDelay                        Stefc
  12.    08.02.96  added dateDaysInMonth, dateYear, dateMonth, dateDay   Stefc
  13.    08.02.96  added IsWin95 constant                                Stefc
  14.    21.02.96  added TMonth & TDay type                              Stefc
  15.    22.02.96  added strFileLoad & strFileSave                       Stefc
  16.    09.03.96  correct sysTempPath                                   Stefc
  17.    09.03.96  added regXXXXX functions for access the registry      Stefc
  18.    24.03.96  added IsWinNT constant                                Stefc
  19.    24.03.96  added SysMetric object                                Stefc
  20.    26.03.96  added dateQuicken for controling date input with keys Stefc
  21.    27.03.96  added TDesktopCanvas here                             Stefc
  22.    28.03.96  added LoadDIBitmap                                    Stefc
  23.    01.04.96  added Question function here                          Stefc
  24.    09.04.96  added sysSaverRunning added                           Stefc
  25.    12.04.96  added timeZoneOffset                                  Stefc
  26.    12.04.96  added timeToInt                                       Stefc
  27.    17.04.96  added strCmdLine                                      Stefc
  28.    17.04.96  added rectBounds                                      Stefc
  29.    17.04.96  added TPersistentRect class                           Stefc
  30.    19.04.96  added strDebug method                                 Stefc
  31.    21.04.96  changed TMonth added noneMonth                        km
  32.    21.04.96  added licence callback                                Stefc
  33.    21.04.96  added strNiceDateDefault                              km
  34.    21.04.96  added simple strEncrpyt & strDecrypt                    Stefc
  35.    24.04.96  backport to 16 bit                                      Stefc
  36.    24.04.96  added Information method                                Stefc
  37.    24.04.96  use win messageBox with Win95 in Question & Information Stefc
  38.    09.05.96  new function ExtractName                                Stefc
  39.    10.05.96  Added TPersistentRegistry                               Stefc
  40.    12.05.96  fileExec                                                Stefc
  41.    14.05.96  New function Confirmation                               Stefc
  42.    16.05.96  New function strChange                                  Stefc
  43. }
  44. unit xProcs;
  45.  
  46. interface
  47.  
  48. uses
  49.  {$IFDEF Win32} Windows, Registry, {$ELSE} WinTypes, WinProcs, {$ENDIF}
  50.   Messages, Classes, Graphics;
  51.  
  52. type
  53.   Float = Extended;
  54.  
  55.  {$IFDEF Win32}
  56.   Int_  = Integer;
  57.  {$ELSE}
  58.   Int_  = Longint;
  59.  {$ENDIF}
  60.  
  61. const
  62.   XCOMPANY        = 'Fabula Software';
  63.  
  64. const
  65.   { several important ASCII codes }
  66.   NULL            =  #0;
  67.   BACKSPACE       =  #8;
  68.   TAB             =  #9;
  69.   LF              = #10;
  70.   CR              = #13;
  71.   ESC             = #27;
  72.   BLANK           = #32;
  73.   SPACE           = BLANK;
  74.  
  75.   { digits as chars }
  76.   ZERO   = '0';  ONE  = '1';  TWO    = '2';  THREE  = '3';  FOUR  = '4';
  77.   FIVE   = '5';  SIX  = '6';  SEVEN  = '7';  EIGHT  = '8';  NINE  = '9';
  78.  
  79.   { special codes }
  80.   SLASH           = '\';     { used in filenames }
  81.   HEX_PREFIX      = '$';     { prefix for hexnumbers }
  82.  
  83.   CRLF            : PChar = #13#10;
  84.  
  85.   { computer sizes }
  86.   KBYTE           = Sizeof(Byte) shl 10;
  87.   MBYTE           = KBYTE        shl 10;
  88.   GBYTE           = MBYTE        shl 10;
  89.  
  90.   { Low floating point value }
  91.   FLTZERO         : Float = 0.00000001;
  92.  
  93.  
  94.   DIGITS          : set of Char = [ZERO..NINE];
  95.  
  96.   { important registry keys / items }
  97.   REG_CURRENT_VERSION = 'Software\Microsoft\Windows\CurrentVersion';
  98.   REG_CURRENT_USER    = 'RegisteredOwner';
  99.   REG_CURRENT_COMPANY = 'RegisteredOrganization';
  100.  
  101.  
  102.  
  103. type
  104.   TMonth     = (NoneMonth,January,February,March,April,May,June,July,
  105.                 August,September,October,November,December);
  106.  
  107.   TDayOfWeek = (Sunday,Monday,Tuesday,Wednesday,Thursday,Friday,Saturday);
  108.  
  109.   TLicCallback = function ( var Code: Integer): Integer;
  110.  
  111.   TBit = 0..31;
  112.  
  113. var
  114.   IsWin95,
  115.   IsWinNT   : Boolean;
  116.   IsFabula  : TLicCallBack;
  117.  
  118. { bit manipulating }
  119.  
  120. function bitSet(const Value: Int_; const TheBit: TBit): Boolean;
  121. function bitOn(const Value: Int_; const TheBit: TBit): Int_;
  122. function bitOff(const Value: Int_; const TheBit: TBit): Int_;
  123. function bitToggle(const Value: Int_; const TheBit: TBit): Int_;
  124.  
  125. { String functions }
  126.  
  127. function  strCut(const S: String; Len: Integer): String;
  128. function  strTrim(const S: String): String;
  129. function  strTrimA(const S: String): String;
  130. function  strTrimChA(const S: String; C: Char): String;
  131. function  strTrimChL(const S: String; C: Char): String;
  132. function  strTrimChR(const S: String; C: Char): String;
  133. function  strLeft(const S: String; Len: Integer): String;
  134. function  strLower(const S: String): String;
  135. function  strMake(C: Char; Len: Integer): String;
  136. function  strPadChL(const S: String; C: Char; Len: Integer): String;
  137. function  strPadChR(const S: String; C: Char; Len: Integer): String;
  138. function  strPadChC(const S: String; C: Char; Len: Integer): String;
  139. function  strPadL(const S: String; Len: Integer): String;
  140. function  strPadR(const S: String; Len: Integer): String;
  141. function  strPadC(const S: String; Len: Integer): String;
  142. function  strPadZeroL(const S: String; Len: Integer): String;
  143. procedure strChange(var S:String; const Source, Dest: String);
  144. function  strRight(const S: String; Len: Integer): String;
  145. function  strAddSlash(const S: String): String;
  146. function  strDelSlash(const S: String): String;
  147. function  strSpace(Len: Integer): String;
  148. function  strToken(var S: String; Seperator: Char): String;
  149. function  strTokenCount(S: String; Seperator: Char): Integer;
  150. function  strTokenAt(const S:String; Seperator: Char; At: Integer): String;
  151. function  strUpper(const S: String): String;
  152. function  strOemAnsi(const S:String): String;
  153. function  strAnsiOem(const S:String): String;
  154. function  strEqual(const S1,S2: String): Boolean;
  155. function  strComp(const S1,S2: String): Boolean;
  156. function  strCompU(const S1,S2: String): Boolean;
  157. function  strNiceNum(const S: String): String;
  158. function  strNiceDateDefault(const S, Default: String): String;
  159. function  strNiceDate(const S: String): String;
  160. function  strNiceTime(const S: String): String;
  161. function  strReplace(const S: String; C: Char; const Replace: String): String;
  162. function  strCmdLine: String;
  163. procedure strDebug(const S: String);
  164. function  strEncrypt(const S: String; Key: Word): String;
  165. function  strDecrypt(const S: String; Key: Word): String;
  166. function  strLastCh(const S: String): Char;
  167. procedure strStripLast(var S: String);
  168. function  strByteSize(Value: Longint): String;
  169.  
  170. {$IFDEF Win32}
  171. function  strFileLoad(const aFile: String): String;
  172. procedure strFileSave(const aFile,aString: String);
  173. {$ENDIF}
  174.  
  175.  
  176. { Integer functions }
  177.  
  178. function  intCenter(a,b: Int_): Int_;
  179. function  intMax(a,b: Int_): Int_;
  180. function  intMin(a,b: Int_): Int_;
  181. function  intPow(Base,Expo: Integer): Int_;
  182. function  intPow10(Exponent: Integer): Int_;
  183. function  intSign(a: Int_): Integer;
  184. function  intZero(a: Int_; Len: Integer): String;
  185.  
  186. { Floatingpoint functions }
  187.  
  188. function  fltAdd(P1,P2: Float; Decimals: Integer): Float;
  189. function  fltDiv(P1,P2: Float; Decimals: Integer): Float;
  190. function  fltEqual(P1,P2: Float; Decimals: Integer): Boolean;
  191. function  fltEqualZero(P: Float): Boolean;
  192. function  fltGreaterZero(P: Float): Boolean;
  193. function  fltLessZero(P: Float): Boolean;
  194. function  fltNeg(P: Float; Negate: Boolean): Float;
  195. function  fltMul(P1,P2: Float; Decimals: Integer): Float;
  196. function  fltRound(P: Float; Decimals: Integer): Float;
  197. function  fltSub(P1,P2: Float; Decimals: Integer): Float;
  198. function  fltUnEqualZero(P: Float): Boolean;
  199. function  fltCalc(const Expr: String): Float;
  200. function  fltPower(a,n: Float): Float;
  201.  
  202. { Rectangle functions from Golden Software }
  203.  
  204. function  rectHeight(const R: TRect): Integer;
  205. function  rectWidth(const R: TRect): Integer;
  206. procedure rectGrow(var R: TRect; Delta: Integer);
  207. procedure rectRelativeMove(var R: TRect; DX, DY: Integer);
  208. procedure rectMoveTo(var R: TRect; X, Y: Integer);
  209. function  rectSet(Left, Top, Right, Bottom: Integer): TRect;
  210. function  rectInclude(const R1, R2: TRect): Boolean;
  211. function  rectPoint(const R: TRect; P: TPoint): Boolean;
  212. function  rectSetPoint(const TopLeft, BottomRight: TPoint): TRect;
  213. function  rectIntersection(const R1, R2: TRect): TRect;
  214. function  rectIsIntersection(const R1, R2: TRect): Boolean;
  215. function  rectIsValid(const R: TRect): Boolean;
  216. function  rectsAreValid(const Arr: array of TRect): Boolean;
  217. function  rectNull: TRect;
  218. function  rectIsNull(const R: TRect): Boolean;
  219. function  rectIsSquare(const R: TRect): Boolean;
  220. function  rectCentralPoint(const R: TRect): TPoint;
  221. function  rectBounds(aLeft,aTop,aWidth,aHeight: Integer): TRect;
  222.  
  223.  
  224. { date functions }
  225.  
  226. function  dateYear(D: TDateTime): Integer;
  227. function  dateMonth(D: TDateTime): Integer;
  228. function  dateDay(D: TDateTime): Integer;
  229. function  dateBeginOfYear(D: TDateTime): TDateTime;
  230. function  dateEndOfYear(D: TDateTime): TDateTime;
  231. function  dateBeginOfMonth(D: TDateTime): TDateTime;
  232. function  dateEndOfMonth(D: TDateTime): TDateTime;
  233. function  dateWeekOfYear(D: TDateTime): Integer;
  234. function  dateDayOfYear(D: TDateTime): Integer;
  235. function  dateDayOfWeek(D: TDateTime): TDayOfWeek;
  236. function  dateLeapYear(D: TDateTime): Boolean;
  237. function  dateBeginOfQuarter(D: TDateTime): TDateTime;
  238. function  dateEndOfQuarter(D: TDateTime): TDateTime;
  239. function  dateBeginOfWeek(D: TDateTime;Weekday: Integer): TDateTime;
  240. function  dateDaysInMonth(D: TDateTime): Integer;
  241. function  dateQuicken(D: TDateTime; Key: Char): TDateTime;
  242.  
  243. { time functions }
  244.  
  245. function  timeHour(T: TDateTime): Integer;
  246. function  timeMin(T: TDateTime): Integer;
  247. function  timeSec(T: TDateTime): Integer;
  248. function  timeToInt(T: TDateTime): Integer;
  249.  
  250. {$IFDEF Win32}
  251. function  timeZoneOffset: Integer;
  252. {$ENDIF}
  253.  
  254.  
  255. { file functions }
  256.  
  257. procedure fileShredder(const Filename: String);
  258. function  fileSize(const Filename: String): Longint;
  259. function  fileWildcard(const Filename: String): Boolean;
  260.  
  261. {$IFDEF Win32}
  262. function  fileTemp(const aExt: String): String;
  263. function  fileExec(const aCmdLine: String; aHide, aWait: Boolean): Boolean;
  264. {$ENDIF}
  265. function  ExtractName(const Filename: String): String;
  266.  
  267. { system functions }
  268.  
  269. function  sysTempPath:String;
  270. procedure sysDelay(aMs: Longint);
  271. {$IFDEF Win32}
  272. procedure sysSaverRunning(Active: Boolean);
  273. {$ENDIF}
  274.  
  275. { registry functions }
  276.  
  277. {$IFDEF Win32}
  278. function  regReadString(aKey: hKey; const Path: String): String;
  279. procedure regWriteString(aKey: hKey; const Path,Value: String);
  280. function  regInfoString(const Value: String): String;
  281. function  regCurrentUser: String;
  282. function  regCurrentCompany: String;
  283. {$ENDIF}
  284.  
  285. { several functions }
  286.  
  287. function  Question(const Msg: String):Boolean;
  288. procedure Information(const Msg: String);
  289. function  Confirmation(const Msg: String): Word;
  290.  
  291. type
  292.   { TRect that can be used persistent as property for components }
  293.   TUnitConvertEvent = function (Sender: TObject;
  294.     Value: Integer; Get: Boolean): Integer of object;
  295.  
  296.   TPersistentRect = class(TPersistent)
  297.   public
  298.     constructor Create;
  299.     procedure Assign(Source: TPersistent); override;
  300.     property Rect: TRect read FRect;
  301.     property OnConvert: TUnitConvertEvent read FOnConvert write FOnConvert;
  302.   published
  303.     property Left  : Integer read GetLeft   write SetLeft;
  304.     property Top   : Integer read GetTop    write SetTop;
  305.     property Height: Integer read GetHeight write SetHeight;
  306.     property Width : Integer read GetWidth  write SetWidth;
  307.   end;
  308.  
  309. {$IFDEF Win32}
  310.   { Persistent access of components from the registry }
  311.   TPersistentRegistry = class(TRegistry)
  312.   public
  313.     function  ReadComponent(const Name: String; Owner, Parent: TComponent): TComponent;
  314.     procedure WriteComponent(const Name: String; Component: TComponent);
  315.   end;
  316. {$ENDIF
  317.  
  318.   { easy access of the system metrics }
  319.   TSystemMetric = class
  320.   protected
  321.     constructor Create;
  322.     procedure Update;
  323.   public
  324.     property MenuHeight: Integer read FMenuHeight;
  325.     property CaptionHeight: Integer read FCaptionHeight;
  326.     property Border: TPoint read FBorder;
  327.     property Frame: TPoint read FFrame;
  328.     property DlgFrame: TPoint read FDlgFrame;
  329.     property Bitmap: TPoint read FBitmap;
  330.     property HScroll: TPoint read FHScroll;
  331.     property VScroll: TPoint read FVScroll;
  332.     property Thumb: TPoint read FThumb;
  333.     property FullScreen: TPoint read FFullScreen;
  334.     property Min: TPoint read FMin;
  335.     property MinTrack: TPoint read FMinTrack;
  336.     property Cursor: TPoint read FCursor;
  337.     property Icon: TPoint read FIcon;
  338.     property DoubleClick: TPoint read FDoubleClick;
  339.     property IconSpacing: TPoint read FIconSpacing;
  340.   end;
  341.  
  342. var
  343.   SysMetric: TSystemMetric;
  344.  
  345. type
  346.   TDesktopCanvas = class(TCanvas)
  347.   public
  348.     constructor  Create;
  349.     destructor   Destroy; override;
  350.   end;
  351.  
  352. implementation
  353.